home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Serious Software / Cherwell Scientific Demos / pro Fit / pro Fit 5.0 demo (fpu).sea / pro Fit 5.0 demo (fpu) / External Modules / External modules sources / Pascal / Inverse erf.p / Inverse erf.p
Encoding:
Text File  |  1996-04-21  |  9.2 KB  |  279 lines  |  [TEXT/PJMM]
  1. {*******************************************************************************}
  2. { ErrorFunction.p                                                    }
  3. {                                                                 }
  4. {                                                                 }
  5. { 27.1.95:        compatibility with Metrowerks Pascal CW 5 }
  6. { 26.9.94:        original version                                }
  7. {*******************************************************************************}
  8.  
  9.  
  10.  
  11. unit user;
  12.  
  13. interface
  14. {$IFC UNDEFINED THINK_PASCAL }
  15.     uses
  16.         Types, fp, proFit_interface;
  17. {$ELSEC}
  18.     uses
  19.         proFit_interface;
  20. {$ENDC}
  21.  
  22. {$MAIN}
  23.     procedure main (selector: integer; pb: ExtModulesParamBlockPtr);
  24.  
  25.  
  26.  
  27. implementation
  28.  
  29. { note: MPW users must make sure that the procedure main is at the beginning of the compiled code }
  30. { under Think Pascal, this is cared for by the compiler }
  31. { We let main call a function mainMain to make sure that the code starts with a jump to }
  32. { our entry point even when compiling under MPW Pascal }
  33.     procedure mainMain (selector: integer; pb: ExtModulesParamBlockPtr);
  34.     forward;
  35.     procedure main (selector: integer; pb: ExtModulesParamBlockPtr);
  36.  
  37.     begin
  38.         mainMain(selector, pb);
  39.     end;
  40.  
  41.  
  42. {***********************************************************************************************}
  43.  
  44.     procedure SetUp (var moduleKind: integer;    { set moduleKind to isFunction or isProgram }
  45.                                     var name: Str255;             { the name of the program or function }
  46.                                     var requiredGlobals: longint;     { the number of bytes to be allocated in ExtModulesParamBlock.globals }
  47.                                         { set requiredGlobals to 0 if you don't use this feature }
  48.                                     pb: ExtModulesParamBlockPtr);    { the complete parameter block passed by pro Fit to the }
  49.                                         { routines defined in this file. In most cases it can be ignored }
  50. { SetUp is called once when the external module is linked to pro Fit }
  51.     begin
  52.         moduleKind := isFunction;
  53.         name := 'Inverse erf';
  54.         requiredGlobals := 0;
  55.     end;
  56.  
  57.  
  58.  
  59. {***********************************************************************************************}
  60.  
  61.     procedure InitializeFunc (var hasDerivatives: boolean;    { set this to true if and only if you define the function }
  62.                                                 { Derivatives to calculate the partial derivatives of the parameters }
  63.                                     var descr1stLine, descr2ndLine: Str255;     { The two lines of the text in the parameter window }
  64.                                     var numberOfParams: integer;             { the number of parameters of the function }
  65.                                     var a0: DefaultParamInfo;                 { the default names, values etc. of the parameters }
  66.                                     pb: ExtModulesParamBlockPtr);            { the complete parameter block passed by pro Fit to the }
  67.                                                 { routines defined in this file. In most cases it can be ignored }
  68. { InitializeFunc is called once (after SetUp has been called) when the external module is linked to pro Fit }
  69. { Used to set all the information needed to describe a function }
  70.         var
  71.             infinite: extended;
  72.     begin
  73.         infinite := 1 / 0;
  74.         hasDerivatives := false;
  75.  
  76.         descr1stLine := 'The inverse of the error function.';
  77.         descr2ndLine := 'y := A*InvErf(x-x0) + const';
  78.  
  79.         numberOfParams := 3;
  80.  
  81.  
  82.  
  83. {   The following is to set parameter names, fitting modes, etc.                     }
  84. {   There are two ways for doing this. The first one sets values, names, etc            }
  85. {   by directly setting the parameter arrays. The second one sets these things            }
  86. {   by using the function "SetParamDefaults", provided by proFit through proFit_interface.p.}
  87. {   In this example, we use both ways.}
  88.  
  89.         a0.value^[1] := 1;
  90.         a0.mode^[1] := inactive;
  91.         a0.name^[1] := 'A';
  92.  
  93.         a0.value^[2] := 0;
  94.         a0.mode^[2] := inactive;
  95.         a0.name^[2] := 'x0';
  96.  
  97.         a0.value^[3] := 0;
  98.         a0.mode^[3] := inactive;
  99.         a0.name^[3] := 'const';
  100.  
  101.     end;
  102.  
  103.  
  104.  
  105. {***********************************************************************************************}
  106.  
  107.     function Check (ParamNo: integer;             { the parameter that was changed }
  108.                                     var a0: DefaultParamInfo;         { the default names, values etc. of the parameters }
  109.                                     pb: ExtModulesParamBlockPtr    { the complete parameter block passed by pro Fit to the}
  110.                                         { routines defined in this file. In most cases it can be ignored }
  111.                                     ): CheckPAnswer;
  112.     { Can be left emtpy (returning good) if not needed. }
  113.     { called when the user has changed a value in the parameters window. This routine }
  114.     { can then check if this parameters is fine. It can also change some of the }
  115.     { other entries in a0. The returned values can be: }
  116.     {    good:        return this value if you agree with the new parameter value }
  117.     {    update:        return this value if you want the parameters window }
  118.     {                to be updated because you changed some of the values in a0 }
  119.     {    bad:        return this value if you want the new parameter value to be refused }
  120.     begin
  121.         Check := good;    { we have nothing to do }
  122.     end;
  123.  
  124.  
  125.  
  126. {***********************************************************************************************}
  127.  
  128.     procedure First (a: ParamArray;             { the new parameters }
  129.                                     pb: ExtModulesParamBlockPtr);    { the complete parameter block passed by pro Fit to the}
  130.                                         { routines defined in this file. In most cases it can be ignored }
  131.  
  132. { Can be left emtpy if not needed. }
  133. { Called whenever the parameters were changed. Can be used to accelerate }
  134. { some calculations. See manual for more info }
  135.     begin
  136.     end;
  137.  
  138.  
  139.  
  140. {***********************************************************************************************}
  141.  
  142.     function InvErf (x: extended): extended;
  143. { returns the inverse of the error function }
  144. { accuracy better than 1e-7 }
  145. { this function was inspired by A.J. Strecok, math. comp. 1968, page 144ff }
  146. { accuracy between -0.999 and 0.999: better than 10E-7 }
  147. { (C) 1996 QuantumSoft }
  148.         var
  149.             y: extended;
  150.     begin
  151. {$IFC UNDEFINED __FP__}
  152.         y := sqrt(-ln(1.0 - x * x));
  153. {$ELSEC}
  154.         y := sqrt(-log(1.0 - x * x));
  155. {$ENDC}
  156.  
  157.         y := y * (0.6374868939151371 + y * (-0.2767067324742911 + y * (0.1503581502062744 + y * (-2.5878691411691874e-2 + y * 9.7670209741420530e-3)))) / (0.7193322618853618 + y * (-0.3122885268724753 + y * (0.1614016565020622 + y * (-2.5947254488147567e-2 + y * 9.7832443176615724e-3))));
  158.  
  159.         if x < 0 then
  160.             y := -y;
  161.         InvErf := y;
  162.     end;
  163.  
  164.  
  165.     procedure Func (x: extended;                 { the x-value }
  166.                                     a: ParamArray;                { the parameters }
  167.                                     var y: extended;             { the y-value }
  168.                                     pb: ExtModulesParamBlockPtr);    { the complete parameter block passed by pro Fit to the}
  169.                                         { routines defined in this file. In most cases it can be ignored }
  170. { called to calculate the y-value of your function for a given x and a given }
  171. { set of parameters }
  172.     begin
  173.         y := a[1] * InvErf(x - a[2]) + a[3];
  174.     end;
  175.  
  176.  
  177.  
  178. {***********************************************************************************************}
  179.  
  180.     procedure Derivatives (x: extended;             { the x-value }
  181.                                     a: ParamArray;                 { the parameters }
  182.                                     var dyda: ParamArray;         { the derivatives }
  183.                                     pb: ExtModulesParamBlockPtr);    { the complete parameter block passed by pro Fit to the }
  184.                                         { routines defined in this file. In most cases it can be ignored }
  185.  
  186.     { Can be left empty if InitializeFunc sets hasDerivatives to false }
  187.     { called to calculate the partial derivatives of the function with respect to }
  188.     { its parameters. If you leave this function empty and set hasDerivatives to false in }
  189.     { FuncInitialize, the derivatives will be calcuated numerically, otherwise pro Fit }
  190.     { calls this function to obtain the values of ALL derivatives. }
  191.     { As a result of the numerical calculation fitting will be slower }
  192.     begin
  193.     end;
  194.  
  195.  
  196.  
  197. {***********************************************************************************************}
  198.  
  199.     procedure Last (pb: ExtModulesParamBlockPtr);
  200. { Can be left emtpy if not needed. }
  201. { Called when calculating is through. See manual for more info }
  202.     begin
  203.     end;
  204.  
  205.  
  206.  
  207.  
  208. {***********************************************************************************************}
  209.  
  210.     procedure CleanUp (pb: ExtModulesParamBlockPtr);
  211.     { called when the function or program is removed from pro Fit's menus }
  212.     { in most cases, this function can be empty }
  213.     begin
  214.     end;
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224. {***********************************************************************************************}
  225.  
  226. { This is the main procedure through which all calls to the external module go.                    }
  227. { Main takes care of calling the right procedure with the right parameters depending on        }
  228. { the value of "selector".                                                                            }
  229. { You don't need to touch this procedure                                                            }
  230.     procedure mainMain (selector: integer; pb: ExtModulesParamBlockPtr);
  231. {$IFC NOT UNDEFINED SET_A4}
  232.         var
  233.             oldA4: longint;
  234. {$ENDC}
  235.     begin
  236. {$IFC NOT UNDEFINED SET_A4}
  237.         oldA4 := SetCurrentA4;
  238. {$ENDC}
  239.         Startup(pb);
  240.         case selector of
  241.             kSetup: 
  242.                 begin
  243.                     pb^.requiredGlobals := 0;
  244.                     pb^.versionNumber := VERSIONNUMBER;
  245.                     if sizeof(extended) = 10 then
  246.                         pb^.codeType := CPU68noFPU
  247.                     else if sizeof(extended) = 12 then
  248.                         pb^.codeType := CPU68FPU
  249.                     else
  250.                         pb^.codeType := CPUPowerPC;
  251.  
  252.                     SetUp(pb^.moduleKind, pb^.name, pb^.requiredGlobals, pb);
  253.                 end;
  254.             funcInitialize: 
  255.                 begin
  256.                     pb^.hasDerivatives := false;
  257.                     InitializeFunc(pb^.hasDerivatives, pb^.descr1, pb^.descr2, pb^.numberOfParams, pb^.a0, pb);
  258.                 end;
  259.             funcCheck: 
  260.                 pb^.answer := ord(Check(pb^.paramNo, pb^.a0, pb));
  261.             funcFirst: 
  262.                 First(pb^.a^, pb);
  263.             funcFunc: 
  264.                 Func(pb^.x^, pb^.a^, pb^.y^, pb);
  265.             funcDerivatives: 
  266.                 Derivatives(pb^.x^, pb^.a^, pb^.dyda^, pb);
  267.             funcLast: 
  268.                 Last(pb);
  269.             kcleanup: 
  270.                 CleanUp(pb);
  271.             otherwise
  272.         end;
  273. {$IFC NOT UNDEFINED SET_A4}
  274.         oldA4 := SetA4(oldA4);
  275. {$ENDC}
  276.     end;
  277.  
  278.  
  279. end.